home *** CD-ROM | disk | FTP | other *** search
/ Internet Surfer: Getting Started / Internet Surfer - Getting Started (Wayzata Technology)(7231)(1995).bin / pc / mac / bonus / peter_le / finger-1 / my_units / mystanda.uni < prev    next >
Text File  |  1992-02-24  |  7KB  |  249 lines
  1. unit MyStandardFile;
  2.  
  3. { This code is part of the Finger/Fingerd source code, written in THINK Pascal 4 }
  4. { Copyright 1991-1992 Peter N Lewis }
  5. { If you use this code, you must give me credit in your about box and documentation }
  6. { This is part of my generic library of routines }
  7.  
  8. interface
  9.  
  10.     type
  11.         MySFReply = record
  12.                 Rgood: boolean;
  13.                 Rfolder: boolean;
  14.                 RfType: OSType;
  15.                 RvRefNum: integer;
  16.                 RdirID: longInt;
  17.                 RfName: str63;
  18.             end;
  19.  
  20.     function MFSPt: point;
  21.     procedure GetFile (ffilter: Ptr; numTypes: integer; typeList: SFTypeList; var reply: MySFReply);
  22.     procedure GetFile1 (t: OSType; var reply: MySFReply);
  23.     procedure GetFolder (ffilter: Ptr; numTypes: integer; typeList: SFTypeList; id: integer; var reply: MySFReply);
  24. { NOTE: GetFolder must be passed a Dialog ID with Button 11 being a folder button }
  25. { NOTE: reply.copy should be interpreted as reply.folder }
  26.     procedure PutFile (str, origName: str255; var reply: MySFreply);
  27.     procedure PutFolder (str, origName: str255; id: integer; var reply: MySFreply);
  28. { NOTE: PutFolder must be passed a Dialog ID with Button 9 being a folder button }
  29. { NOTE: reply.copy should be interpreted as reply.folder }
  30.     function Button11Hook (item: integer; dlg: DialogPtr): integer;
  31. { NOTE: Button11Hook sets Button11 when it converts Button 11 to Button 1 (Open) }
  32.     function Button9Hook (item: integer; dlg: DialogPtr): integer;
  33. { NOTE: Button9Hook sets Button9 when it converts Button 9 to Button 1 (Save) }
  34.     procedure SetSFFile (wdrn: integer; dirID: longInt);
  35.     procedure SegmentStandardFile;
  36.  
  37. implementation
  38.  
  39.     uses
  40.         MyTypes, MyUtils, MyUtilities, MyFileSystem, MyButtons;
  41.  
  42.  {$S StandardFile}
  43.     procedure SegmentStandardFile;
  44.     begin
  45.     end;
  46.  
  47.     procedure SetSFFile (wdrn: integer; dirID: longInt);
  48.         var
  49.             oe: OSErr;
  50.             vrn: integer;
  51.             procID: longInt;
  52.             s: str255;
  53.     begin
  54.         if dirID = 0 then
  55.             oe := GetWDInfo(wdrn, vrn, dirID, procID)
  56.         else
  57.             vrn := wdrn;
  58.         integerP(SFSaveDiskA)^ := -vrn;
  59.         longIntP(CurDirStoreA)^ := dirID;
  60.     end;
  61.  
  62.     function MFSPt: point;
  63.         var
  64.             pt: point;
  65.     begin
  66.         pt.v := 40;
  67.         pt.h := 40;
  68.         MFSPt := pt;
  69.     end;
  70.  
  71.     procedure SetStdReply (var reply: MySFReply; stdReply: StandardFileReply);
  72.     begin
  73.         with reply do begin
  74.             Rgood := stdReply.sfGood;
  75.             Rfolder := ord(stdReply.sfIsFolder) <> 0;        { Argghhh!  Bloody Apple and there C booleans! }
  76.             RfType := stdReply.sfType;
  77.             RvRefNum := stdReply.sfFile.vRefNum;
  78.             RdirID := stdReply.sfFile.parID;
  79.             RfName := stdReply.sfFile.name;
  80.         end;
  81.     end;
  82.  
  83.     procedure SetOldReply (var reply: MySFReply; oldReply: SFReply);
  84.         var
  85.             oe: OSErr;
  86.     begin
  87.         with reply do begin
  88.             Rgood := oldReply.good;
  89.             Rfolder := oldReply.copy;
  90.             RfType := oldReply.fType;
  91.             oe := GetDirID(oldReply.vRefNum, RvRefNum, RdirID);
  92.             RfName := oldReply.fName;
  93.         end;
  94.     end;
  95.  
  96.     procedure GetFile (ffilter: Ptr; numTypes: integer; typeList: SFTypeList; var reply: MySFReply);
  97.         var
  98.             stdReply: StandardFileReply;
  99.             oldReply: SFReply;
  100.     begin
  101.         with reply do
  102.             if has_newStdFile then begin
  103.                 StandardGetFile(ffilter, numTypes, typeList, stdReply);
  104.                 SetStdReply(reply, stdReply);
  105.             end
  106.             else begin
  107.                 SFGetFile(MFSPt, '', ffilter, numTypes, typeList, nil, oldReply);
  108.                 oldReply.copy := false;
  109.                 SetOldReply(reply, oldReply);
  110.             end;
  111.     end;
  112.  
  113.     procedure GetFile1 (t: OSType; var reply: MySFReply);
  114.         var
  115.             typeList: SFTypeList;
  116.     begin
  117.         if t = OSType(noType) then
  118.             GetFile(nil, -1, typeList, reply)
  119.         else begin
  120.             typeList[0] := t;
  121.             GetFile(nil, 1, typeList, reply);
  122.         end;
  123.     end;
  124.  
  125.     procedure PutFile (str, origName: str255; var reply: MySFreply);
  126.         var
  127.             stdReply: StandardFileReply;
  128.             oldReply: SFReply;
  129.     begin
  130.         with reply do
  131.             if has_newStdFile then begin
  132.                 StandardPutFile(str, origname, stdReply);
  133.                 SetStdReply(reply, stdReply);
  134.             end
  135.             else begin
  136.                 SFPutFile(MFSPt, str, origname, nil, oldReply);
  137.                 oldReply.copy := false;
  138.                 SetOldReply(reply, oldReply);
  139.             end;
  140.     end;
  141.  
  142.     var
  143.         oldReply: SFReply;
  144.         newReply: StandardFileReply;
  145. { item1 is ThisFolder }
  146.         item1: integer;
  147.         button1: boolean;
  148.         active1: boolean;
  149.  
  150.     procedure SetButtons (dlg: dialogPtr);
  151.         var
  152.             new1: boolean;
  153.     begin
  154.         if has_newStdFile then begin
  155.             new1 := newReply.sfFile.parID <> 1; { everywhere except  desktop???? }
  156.         end
  157.         else begin
  158.             new1 := true;
  159.         end;
  160.         SetButton(dlg, item1, active1, new1);
  161.     end;
  162.  
  163.     function ButtonModalFilter (dlg: dialogPtr; var er: eventRecord; var item: integer): boolean;
  164.     begin
  165.         SetButtons(dlg);
  166.         if (er.what = updateEvt) and (dlg = dialogPtr(er.message)) then begin
  167.             UpdateButton(dlg, item1, active1);
  168.         end;
  169.         ButtonModalFilter := false;
  170.     end;
  171.  
  172.     function ButtonModalFilterSys7 (dlg: dialogPtr; var er: eventRecord; var item: integer; data: ptr): boolean;
  173.     begin
  174.         ButtonModalFilterSys7 := ButtonModalFilter(dlg, er, item);
  175.     end;
  176.  
  177.     function ButtonHook (item: integer; dlg: DialogPtr): integer;
  178.     begin
  179.         if not has_newStdFile or (GetWRefCon(dlg) = longint(sfMainDialogRefCon)) then begin
  180.             if item = sfHookFirstCall then begin
  181.                 button1 := false;
  182.                 InitButton(dlg, item1, active1, active1);
  183.                 SetButtons(dlg);
  184.             end;
  185.             if active1 then begin
  186.                 if item <> sfHookLastCall then begin
  187.                     button1 := item = item1;
  188.                     if button1 then
  189.                         item := sfItemOpenButton;
  190.                 end;
  191.             end;
  192.         end;
  193.         ButtonHook := item;
  194.     end;
  195.  
  196.     function ButtonHookSys7 (item: integer; dlg: DialogPtr; data: ptr): integer;
  197.     begin
  198.         ButtonHookSys7 := ButtonHook(item, dlg);
  199.     end;
  200.  
  201.     procedure PutFolder (str, origName: str255; id: integer; var reply: MySFreply);
  202.     begin
  203.         if has_newStdFile then begin
  204.             item1 := 13;
  205.             active1 := true;
  206.             CustomPutFile(str, origName, newReply, id + 1, MFSPt, @ButtonHookSys7, @ButtonModalFilterSys7, nil, nil, nil); {@ButtonModalFilterSys7}
  207.             SetStdReply(reply, newReply);
  208.             reply.Rfolder := button1;
  209.         end
  210.         else begin
  211.             item1 := 9;
  212.             active1 := true;
  213.             SFPPutFile(MFSPt, str, origname, @ButtonHook, oldReply, id, nil);
  214.             oldReply.copy := button1;
  215.             SetOldReply(reply, oldReply);
  216.         end;
  217.     end;
  218.  
  219.     function CallFileFilterSys7 (pb: CInfoPBPtr; addr: ptr): boolean;
  220.     inline
  221.         $205F, $4E90;
  222.  
  223.     function FileFilterSys7 (pb: CInfoPBPtr; addr: ptr): boolean;
  224.     begin
  225.         if (BAND(pb^.ioFlAttrib, $0010) = 0) and (addr <> nil) then
  226.             FileFilterSys7 := CallFileFilterSys7(pb, addr)
  227.         else
  228.             FileFilterSys7 := false;
  229.     end;
  230.  
  231.     procedure GetFolder (ffilter: Ptr; numTypes: integer; typeList: SFTypeList; id: integer; var reply: MySFReply);
  232.     begin
  233.         if has_newStdFile then begin
  234.             item1 := 10;
  235.             active1 := true;
  236.             CustomGetFile(@FileFilterSys7, numTypes, typeList, newReply, id + 1, MFSpt, @ButtonHookSys7, @ButtonModalFilterSys7, nil, nil, ffilter);
  237.             SetStdReply(reply, newReply);
  238.             reply.Rfolder := button1;
  239.         end
  240.         else begin
  241.             item1 := 11;
  242.             active1 := true;
  243.             SFPGetFile(MFSPt, '', ffilter, numTypes, typeList, @ButtonHook, oldReply, id, nil);
  244.             oldReply.copy := button1;
  245.             SetOldReply(reply, oldReply);
  246.         end;
  247.     end;
  248.  
  249. end.